    Baraj ziua 3 (Selectie lot IOI, Cluj  mai 1996)
    Problema 3 (Tetris)

     Se dau n obiecte de apte forme diferite, formate din cte patru p[tr[ele, conform figurii de mai
jos:

  ----------------          ---------       ---------           -----
  |    |    |    |          |   |   |       |   |   |           |   |
  ----------------      -------------       -------------       -----
       |    |           |   |   |               |   |   |       |   |
       ------           ---------               ---------       -----
            (1)                  (2)                 (3)        |   |
                                                                -----
       ---------         -------------               -----      |   |
       |   |   |         |   |   |   |               |   |      -----
       ---------         -------------       -------------       (7)
       |   |   |                 |   |       |   |   |   |
       ---------                 -----       -------------
          (4)                     (5)                (6)

    Se d[ o tabl[ dreptunghiular[ avnd n/3 linii de cte 12 p[tr[ele care trebuie acoperite cu
asemenea obiecte (n este divizibil cu 3). Planul tablei este identic cu planurile celor n obiecte.
Dndu-se cele n obiecte, ele trebuie puse pe tabl[ prin translat[ri i rotaii cu 90o,180o i 270o n
propriul lor plan, astfel nct s[ nu r[mn[ nici una din p[tr[ele neacoperit[, respectiv obiectele s[
nu se suprapun[. Cu cele n obiecte date ntotdeauna se poate acoperi tabla, respectnd cerinele problemei.
Date de intrare:
    Fiierul de tip text, al c[rui nume se citete de la tastatur[, are urm[toarea structur[:
- pe prima linie un num[r ntreg, reprezentnd num[rul de obiecte (n18);
- pe urm[toarea linie se afl[ numerele de identificare ale obiectelor; obiectele sunt ntr-o succesiune
oarecare.
Date de ieire:
    In fiierul de ieire se va scrie o matrice avnd n/3 linii i 12 coloane care va fi construit[ n
felul urm[tor:
    Corespunz[tor fiec[rui obiect se va scrie, respectnd forma obiectului, de patru ori num[rul de
ordine al s[u, adic[ indicele obiectului n irul din fiierul de intrare. Elementele matricei se vor scrie n
fiier linie dup[ linie, desp[rite printr-un blanc. Nu se vor pune blancuri n faa primei coloane i dup[
ultima coloan[. Se cere o singur[ soluie.
Exemplu: Pentru coninutul fiierului de intrare:
6
7 7 4 4 6 6
coninutul fiierului de ieire va putea fi:
2 2 2 2 3 3 4 4 5 5 5 6
1 1 1 1 3 3 4 4 5 6 6 6
Not[: timp maxim de executare: 1 minut.
Punctaj maxim: 100 puncte.
======================================================
teste:
3
7 7 7
-------------------------
9
5 4 1 1 3 6 2 7 4
---------------------------
12
5 5 4 1 7 1 2 2 7 7 4 5
------------------------------
15
1 1 1 1 3 3 4 4 5 5 5 6 7 7 7
------------------------------
18
1 1 1 1 2 2 3 3 4 5 5 6 6 6 6 6 7 7
------------------------------
1 1 1 1 2 2 3 3 5 5 5 6
4 4 4 4 2 2 3 3 5 6 6 6
--------------------------------
1
1
1 1
-------------------------------------------
Solutia 1 (Mihai Badoiu):
{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y-}
{$M 65520,0,655360}
const
    piesa:array[1..7,1..4,1..2] of integer=
    (
    ((0,0),(1,0),(2,0),(1,1)),
    ((1,0),(2,0),(0,1),(1,1)),
    ((0,0),(1,0),(1,1),(2,1)),
    ((0,0),(1,0),(0,1),(1,1)),
    ((0,0),(1,0),(2,0),(2,1)),
    ((2,0),(0,1),(1,1),(2,1)),
    ((0,0),(1,0),(2,0),(3,0))
    );
var
    n,m:integer;
    v:array[-6..32,-6..24] of integer;
    vs:array[1..18] of byte;
    ob:array[1..32] of integer;
    vs2:array[-6..32] of integer;

procedure load;
var
    f:text;
    nume:string;
    i:integer;
begin
    write('fisier intrare = ');
    readln(nume);
    assign(f,nume);
    reset(f);
    readln(f,n);
    for i:=1 to n do
             read(f,ob[i]);
    close(f);
end;

procedure scs;
var
    f:text;
    nume:string;
    i,j:integer;
begin
    write('fisier iesire= ');
    readln(nume);
    assign(f,nume);
    rewrite(f);
    for i:=1 to m do
    begin
             for j:=1 to 11 do
                           write(f,v[i,j],' ');
             writeln(f,v[i,12]);
             end;
    close(f);
    halt;
end;
procedure bk(y,x2:integer);
var
    p,j,x,y2:integer;
    q1,q2:integer;
    r,t:integer;
begin
    if y=0 then
             scs
    else
    begin
             if vs2[y]=12 then
             begin
                           bk(y-1,1);
                           exit;
                           end;
             while v[y,x2]<>0 do
                           inc(x2);
             for p:=1 to n do
             if vs[p]=0 then
             begin
                           vs[p]:=1;
             for y2:=y downto y-1 do
             for x:=1 to 12 do
                                              for q1:=-1 to 1 do
                                                                      if q1<>0 then
                                                                                                   for q2:=-1 to 1 do
                                                                                                                                     if q2<>0 then
                                                                                                                                     begin
                                                                                                                                     for j:=1 to 4 do
                                                                                                                                     begin
                                                                                                                                                                            if
(v[y2+q1*piesa[ob[p],j,2],(x+q2*piesa[ob[p],j,1])]<>0) then
                                                                                                                                                                            begin
                                                                                                                                                                                                                        j:=1;
                                                                                                                                                                                                                        break;
                                                                                                                                                                                                                        end;
                                                                                                                                                                            end;
                                                                                                                                     if j<>1 then
                                                                                                                                     begin
                                                                                                                                                                            for j:=1 to 4 do
                                                                                                                                                                            begin
                                                                                                                                                                                                                        v[y2+q1*piesa[ob[p],j,2],x+q2*piesa[ob[p],j,1]]:=p;
                                                                                                                                                                                                                        inc(vs2[y2+q1*piesa[ob[p],j,2]]);
                                                                                                                                                                                                                        end;
                                                                                                                                                                            if v[y,x2]<>0 then
                                                                                                                                                                                                                        bk(y,x2+1);
                                                                                                                                                                            for j:=1 to 4 do
                                                                                                                                                                            begin
                                                                                                                                                                                                                        v[y2+q1*piesa[ob[p],j,2],x+q2*piesa[ob[p],j,1]]:=0;
                                                                                                                                                                                                                        dec(vs2[y2+q1*piesa[ob[p],j,2]]);
                                                                                                                                                                                                                        end;
                                                                                                                                                                            end;
                                                                                                   end;
                                                                      vs[p]:=0;
                                                                      end;
                                              end;
end;

procedure init;
var
    i:integer;
begin
    for i:=0 to 13 do
    begin
             v[0,i]:=1;
             v[m+1,i]:=1;
             end;
    for i:=0 to m do
    begin
             v[i,0]:=1;
             v[i,13]:=1;
             end;
end;

procedure calcul;
var
    i:integer;
begin
    m:=n div 3;
    init;
    bk(m,1);
end;

begin
    load;
    calcul;
end.
--------------------------------
Solutia 2 (Catalin Francu):
program Tetris;
{$B-,I-,R-,S-}
type Element=record
               Ind,Kind:Integer;
             end;
     Matrix=array[1..6,1..12] of Element;
     IntegerVector=array[1..18] of Integer;
var N,NL:Integer;
    A:Matrix;
    Disp,P,Level,Coresp:IntegerVector;
    SO:String;

procedure ReadData;
var i,j:Integer;
    S:String;
begin
  Write('Numele fisierului de intrare: ');ReadLn(S);
  Write('Numele fisierului de iesire: ');ReadLn(SO);
  Assign(Input,S);Reset(Input);
  ReadLn(N);
  NL:=N div 3;
  for i:=1 to 7 do Disp[i]:=0;
  for i:=1 to NL do Level[i]:=0;
  for i:=1 to N do
    begin
      Read(P[i]);
      Inc(Disp[P[i]]);
    end;
  Close(Input);
end;

procedure WriteMatrix;
var i,j:Integer;
begin
  Assign(Output,SO);Rewrite(Output);
  for i:=1 to NL do
    begin
      for j:=1 to 11 do Write(Coresp[A[i,j].Ind],' ');
      WriteLn(Coresp[A[i,12].Ind]);
    end;
  Close(Output);
end;

procedure IGotIt;
var i,j,k:Integer;
begin
  for i:=1 to N do Coresp[i]:=0;
  for i:=1 to NL do
    for j:=1 to 12 do
      if Coresp[A[i,j].Ind]=0
        then begin
               k:=0;
               repeat Inc(k) until A[i,j].Kind=P[k];
               Coresp[A[i,j].Ind]:=k;
               P[k]:=0;
             end;
  WriteMatrix;
  Halt;
end;
procedure PutAPiece(X,Y,Z,T,Kind,Index:Integer);
begin
  Inc(Level[X]);
  A[X,Level[X]].Ind:=Index;
  A[X,Level[X]].Kind:=Kind;
  Inc(Level[Y]);
  A[Y,Level[Y]].Ind:=Index;
  A[Y,Level[Y]].Kind:=Kind;
  Inc(Level[Z]);
  A[Z,Level[Z]].Ind:=Index;
  A[Z,Level[Z]].Kind:=Kind;
  Inc(Level[T]);
  A[T,Level[T]].Ind:=Index;
  A[T,Level[T]].Kind:=Kind;
  Dec(Disp[Kind]);
end;

procedure TakeAPiece(X,Y,Z,T,Kind:Integer);
begin
  Dec(Level[X]);
  Dec(Level[Y]);
  Dec(Level[Z]);
  Dec(Level[T]);
  Inc(Disp[Kind]);
end;

procedure PlacePieces(K:Integer); forward;

procedure Try1(K:Integer);
var i:Integer;
begin
  if Disp[1]>0
    then begin
           for i:=1 to NL-1 do
             if (Level[i]=1+Level[i+1]) and (Level[i]<=10)
               then begin
                      PutAPiece(i,i+1,i+1,i+1,1,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+1,i+1,1);
                    end;
           for i:=1 to NL-1 do
             if (Level[i]+1=Level[i+1]) and (Level[i]<=9)
               then begin
                      PutAPiece(i,i,i,i+1,1,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i,i+1,1);
                    end;
           for i:=1 to NL-2 do
             if ((Level[i]=Level[i+1]) and (Level[i]=Level[i+2])
                and (Level[i]<=10))
             or ((Level[i]=1+Level[i+1]) and (Level[i]=Level[i+2])
                and (Level[i]<=11))
               then begin
                      PutAPiece(i,i+1,i+1,i+2,1,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+1,i+2,1);
                    end;
         end;
end;

procedure Try2(K:Integer);
var i:Integer;
begin
  if Disp[2]>0
    then begin
           for i:=1 to NL-1 do
             if (Level[i]=1+Level[i+1]) and (Level[i]<=10)
               then begin
                      PutAPiece(i,i,i+1,i+1,2,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i+1,i+1,2);
                    end;
           for i:=1 to NL-2 do
             if (Level[i]=Level[i+1]) and (Level[i]+1=Level[i+2])
                and (Level[i]<=10)
               then begin
                      PutAPiece(i,i+1,i+1,i+2,2,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+1,i+2,2);
                    end;
         end;
end;

procedure Try3(K:Integer);
var i:Integer;
begin
  if Disp[3]>0
    then begin
           for i:=1 to NL-1 do
             if (Level[i]+1=Level[i+1]) and (Level[i]<=9)
               then begin
                      PutAPiece(i,i,i+1,i+1,3,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i+1,i+1,3);
                    end;
           for i:=1 to NL-2 do
             if (Level[i]=1+Level[i+1]) and (Level[i+1]=Level[i+2])
                and (Level[i]<=11)
               then begin
                      PutAPiece(i,i+1,i+1,i+2,3,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+1,i+2,3);
                    end;
         end;
end;

procedure Try4(K:Integer);
var i:Integer;
begin
  if Disp[4]>0
    then for i:=1 to NL-1 do
           if (Level[i]=Level[i+1]) and (Level[i]<=10)
             then begin
                    PutAPiece(i,i,i+1,i+1,4,K);
                    PlacePieces(K+1);
                    TakeAPiece(i,i,i+1,i+1,4);
                  end;
end;

procedure Try5(K:Integer);
var i:Integer;
begin
  if Disp[5]>0
    then begin
           for i:=1 to NL-1 do
             if (Level[i]+2=Level[i+1]) and (Level[i]<=9)
               then begin
                      PutAPiece(i,i,i,i+1,5,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i,i+1,5);
                    end;
           for i:=1 to NL-1 do
             if (Level[i]=Level[i+1]) and (Level[i+1]<=9)
               then begin
                      PutAPiece(i,i+1,i+1,i+1,5,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+1,i+1,5);
                    end;
           for i:=1 to NL-2 do
             if (Level[i]=Level[i+1]) and (Level[i]=Level[i+2])
                and (Level[i]<=10)
               then begin
                      PutAPiece(i,i,i+1,i+2,5,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i+1,i+2,5);
                    end;
           for i:=1 to NL-2 do
             if (Level[i]=Level[i+1]) and (Level[i]=1+Level[i+2])
                and (Level[i]<=11)
               then begin
                      PutAPiece(i,i+1,i+2,i+2,5,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+2,i+2,5);
                    end;
         end;
end;

procedure Try6(K:Integer);
var i:Integer;
begin
  if Disp[6]>0
    then begin
           for i:=1 to NL-1 do
             if (Level[i]=2+Level[i+1]) and (Level[i]<=11)
               then begin
                      PutAPiece(i,i+1,i+1,i+1,6,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+1,i+1,6);
                    end;
           for i:=1 to NL-1 do
             if (Level[i]=Level[i+1]) and (Level[i]<=9)
               then begin
                      PutAPiece(i,i,i,i+1,6,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i,i+1,6);
                    end;
           for i:=1 to NL-2 do
             if (Level[i]=Level[i+1]) and (Level[i]=Level[i+2])
                and (Level[i]<=10)
               then begin
                      PutAPiece(i,i+1,i+2,i+2,6,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+2,i+2,6);
                    end;
           for i:=1 to NL-2 do
             if (Level[i]+1=Level[i+1]) and (Level[i+1]=Level[i+2])
                and (Level[i]<=10)
               then begin
                      PutAPiece(i,i,i+1,i+2,6,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i+1,i+2,6);
                    end;
         end;
end;

procedure Try7(K:Integer);
var i:Integer;
begin
  if Disp[7]>0
    then begin
           for i:=1 to NL do
             if (Level[i]<=8)
               then begin
                      PutAPiece(i,i,i,i,7,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i,i,i,7);
                    end;
           for i:=1 to NL-3 do
             if (Level[i]=Level[i+1]) and (Level[i]=Level[i+2])
                and (Level[i]=Level[i+3]) and (Level[i]<=11)
               then begin
                      PutAPiece(i,i+1,i+2,i+3,7,K);
                      PlacePieces(K+1);
                      TakeAPiece(i,i+1,i+2,i+3,7);
                    end;
         end;
end;

procedure PlacePieces(K:Integer);
var i:Integer;
begin
  if K=N+1
    then IGotIt
    else begin
           Try7(K);
           Try4(K);
           Try5(K);
           Try6(K);
           Try1(K);
           Try2(K);
           Try3(K);
         end;
end;

begin
  ReadData;
  PlacePieces(1);
end.
-----------------------------------
Solutia 3 (Vlad petric):
{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}
program prob3;

type piesa=array[1..3,1..3] of byte;
const pies:array[1..6] of piesa=(
                               ((1,1,1),(0,1,0),(0,0,0)),
                               ((0,1,1),(1,1,0),(0,0,0)),
                               ((1,1,0),(0,1,1),(0,0,0)),
                               ((1,1,0),(1,1,0),(0,0,0)),
                               ((1,1,1),(0,0,1),(0,0,0)),
                               ((0,0,1),(1,1,1),(0,0,0)));



procedure rotate(var p1,p2:piesa);
var i,j:byte;
begin
  for i:=1 to 3 do
    for j:=1 to 3 do
      p2[j,3-i+1]:=p1[i,j];
end;
type tab=array[1..6,1..12] of byte;
var tabla:tab;
    vect:array[1..18] of byte;
    n:byte;

procedure citire;
var f:text;
    nf:string;
    i,a:byte;
begin
  write('Nume fishier intrare:');
  readln(nf);
  assign(f,nf);
  reset(f);
  readln(f,n);
  FillChar(vect,sizeof(vect),0);
  FillChar(tabla,sizeof(tabla),0);
  for i:=1 to n do
    read(f,vect[i]);
end;

function posibil(var t:tab;var p:piesa;x,y:byte):boolean;
var i,j:byte;
begin
  for i:=1 to 3 do
    for j:=1 to 3 do
      if  (p[i,j]=1) and ( (t[x+i-1,y+j-1]<>0) or  (x+i-1>n div 3) or (y+j-1>12) )   then begin
        posibil:=false;
        exit;
      end;
  posibil:=true;
{  writeln(x,' ',y);}
end;

procedure add(var t:tab;var p:piesa;x,y,ps:byte);
var i,j:byte;
begin
  for i:=1 to 3 do
    for j:=1 to 3 do
      if (x+i-1<=n div 3) and (y+j-1<=12) then
        inc(t[x+i-1,y+j-1],p[i,j]*ps);
end;


procedure backtrack(puse:byte);
var k,i,j:byte;
    nf:string;
    f:text;
    p,q:piesa;
begin
{  if puse=6 then
    writeln;
  for i:=1 to n div 3 do begin
    writeln;
    for j:=1 to 12 do
      write(tabla[i,j]:3);
  end;
  readln;}
   if puse=n then begin
    writeln('nume fisier iesire:');
    readln(nf);
    assign(f,nf);
    rewrite(f);
    for i:=1 to n div 3 do begin
      for j:=1 to 12 do begin
        write(f,tabla[i,j]);
        if j<>12 then write(f,' ');
      end;
      writeln(f);
    end;
    close(f);
    halt;
  end
  else
    if vect[puse+1]<>7 then begin
      p:=pies[vect[puse+1]];
      for k:=1 to 4 do begin

        for i:=0 to n div 3 do
          for j:=1 to 12 do
            if posibil(tabla,p,i,j) then begin
              add(tabla,p,i,j,puse+1);
              backtrack(puse+1);
              add(tabla,p,i,j,-puse-1);
            end;

        rotate(p,q);
        p:=q;
      end;
    end
    else
      for i:=1 to n div 3 do
        for j:=1 to 12 do
          if (j+4-1<12) and (tabla[i,j]=0) and (tabla[i,j+1]=0) and (tabla[i,j+2]=0)  and (tabla[i,j+3]=0) then
begin
            tabla[i,j]:=puse+1;
            tabla[i,j+1]:=puse+1;
            tabla[i,j+2]:=puse+1;
            tabla[i,j+3]:=puse+1;
            backtrack(puse+1);
            tabla[i,j]:=0;
            tabla[i,j+1]:=0;
            tabla[i,j+2]:=0;
            tabla[i,j+3]:=0;

          end;

end;



begin
  citire;
  backtrack(0);
end.
-------------------------------------
